Beadandó

Az adattudomány statisztikai alapjai tárgy, 2024/25/1 félév 2024.12.04 Gellén Rebeka

Adat beolvasása

Olyan adatbázissal dolgozunk, ahol Spotify-on megtalálható zenék adatai szerepelnek.

data <- read.csv("spotify.csv")
head(data)
##                 track_id                                            track_name
## 1 6f807x0ima9a1j3VPbc7VN I Don't Care (with Justin Bieber) - Loud Luxury Remix
## 2 0r7CVbZTWZgbTCYdfa2P31                       Memories - Dillon Francis Remix
## 3 1z1Hg7Vb0AhHDiEmnDE79l                       All the Time - Don Diablo Remix
## 4 75FpbthrwQmzHlBJLuGdC7                     Call You Mine - Keanu Silva Remix
## 5 1e8PAfcKUYoKkxPhrHqw4x               Someone You Loved - Future Humans Remix
## 6 7fvUMiyapMsRRxr07cU8Ef     Beautiful People (feat. Khalid) - Jack Wins Remix
##       track_artist track_popularity         track_album_id
## 1       Ed Sheeran               66 2oCs0DGTsRO98Gh5ZSl2Cx
## 2         Maroon 5               67 63rPSO264uRjW1X5E6cWv6
## 3     Zara Larsson               70 1HoSmj2eLcsrR0vE9gThr4
## 4 The Chainsmokers               60 1nqYsOef1yKKuGOVchbsk6
## 5    Lewis Capaldi               69 7m7vv9wlQ4i0LFuJiE2zsQ
## 6       Ed Sheeran               67 2yiy9cd2QktrNvWC2EUi0k
##                                        track_album_name
## 1 I Don't Care (with Justin Bieber) [Loud Luxury Remix]
## 2                       Memories (Dillon Francis Remix)
## 3                       All the Time (Don Diablo Remix)
## 4                           Call You Mine - The Remixes
## 5               Someone You Loved (Future Humans Remix)
## 6     Beautiful People (feat. Khalid) [Jack Wins Remix]
##   track_album_release_date playlist_name            playlist_id playlist_genre
## 1               2019-06-14     Pop Remix 37i9dQZF1DXcZDD7cfEKhW            pop
## 2               2019-12-13     Pop Remix 37i9dQZF1DXcZDD7cfEKhW            pop
## 3               2019-07-05     Pop Remix 37i9dQZF1DXcZDD7cfEKhW            pop
## 4               2019-07-19     Pop Remix 37i9dQZF1DXcZDD7cfEKhW            pop
## 5               2019-03-05     Pop Remix 37i9dQZF1DXcZDD7cfEKhW            pop
## 6               2019-07-11     Pop Remix 37i9dQZF1DXcZDD7cfEKhW            pop
##   playlist_subgenre danceability energy key loudness mode speechiness
## 1         dance pop        0.748  0.916   6   -2.634    1      0.0583
## 2         dance pop        0.726  0.815  11   -4.969    1      0.0373
## 3         dance pop        0.675  0.931   1   -3.432    0      0.0742
## 4         dance pop        0.718  0.930   7   -3.778    1      0.1020
## 5         dance pop        0.650  0.833   1   -4.672    1      0.0359
## 6         dance pop        0.675  0.919   8   -5.385    1      0.1270
##   acousticness instrumentalness liveness valence   tempo duration_ms
## 1       0.1020         0.00e+00   0.0653   0.518 122.036      194754
## 2       0.0724         4.21e-03   0.3570   0.693  99.972      162600
## 3       0.0794         2.33e-05   0.1100   0.613 124.008      176616
## 4       0.0287         9.43e-06   0.2040   0.277 121.956      169093
## 5       0.0803         0.00e+00   0.0833   0.725 123.976      189052
## 6       0.0799         0.00e+00   0.1430   0.585 124.982      163049

PCA

Numerikus oszlopok kiválasztása

num_data <- data[, c("danceability", "energy", "valence", "tempo", "loudness")]
head(num_data)
##   danceability energy valence   tempo loudness
## 1        0.748  0.916   0.518 122.036   -2.634
## 2        0.726  0.815   0.693  99.972   -4.969
## 3        0.675  0.931   0.613 124.008   -3.432
## 4        0.718  0.930   0.277 121.956   -3.778
## 5        0.650  0.833   0.725 123.976   -4.672
## 6        0.675  0.919   0.585 124.982   -5.385
pca_model <- prcomp(num_data, scale = TRUE)
summary(pca_model)
## Importance of components:
##                           PC1    PC2    PC3    PC4     PC5
## Standard deviation     1.3205 1.1791 0.9602 0.8068 0.54137
## Proportion of Variance 0.3488 0.2781 0.1844 0.1302 0.05862
## Cumulative Proportion  0.3488 0.6268 0.8112 0.9414 1.00000
pca_model$rotation
##                      PC1          PC2         PC3        PC4         PC5
## danceability -0.04173127  0.697432291  0.06026072 -0.6860986 -0.19360798
## energy        0.68991962 -0.007942764 -0.12388735  0.1365999 -0.69995730
## valence       0.16156962  0.615509115  0.44429271  0.6009973  0.19091899
## tempo         0.22785514 -0.365926181  0.84478995 -0.3165530  0.01744149
## loudness      0.66651835  0.027778965 -0.26448914 -0.2218234  0.66016776

Screeplot

screeplot(pca_model, main = "Screeplot", col = "pink")

# Biplot készítése
biplot(pca_model, main = "PCA Biplot", col = "pink")

library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.4.2
pca_data <- as.data.frame(pca_model$x)
ggplot(pca_data, aes(PC1, PC2)) +
  geom_point() +
  theme_minimal() +
  labs(title = "PCA ábra", x = "Főkomponens 1", y = "Főkomponens 2")

Az ábra a főkomponens-analízis (PCA) eredményeit mutatja, ahol az első két főkomponens (PC1 és PC2) a teljes változékonyság legnagyobb részét magyarázza. Az adatpontok elhelyezkedése az eredeti változók közötti mintázatok és különbségek vizualizálását segíti elő. Az első két főkomponens szerint az adatok jelentős része hasonló mintázatot követ.

MDS

# egy véletlenszerű minta az adatból
set.seed(123)
sample_data <- num_data[sample(nrow(num_data), 1000), ]
dist_matrix <- dist(sample_data)
mds_model <- cmdscale(dist_matrix, k = 2)

MDS eredmények ábrázolása

mds_data <- as.data.frame(mds_model)
colnames(mds_data) <- c("MDS1", "MDS2")
ggplot(mds_data, aes(MDS1, MDS2)) +
  geom_point() +
  theme_minimal() +
  labs(title = "MDS ábra", x = "MDS1", y = "MDS2")

Az ábra jól mutatja, hogy a random választott 100 adatban többféle zenét sikerült kiválasztani, így nem lehet egyértelmű csoportokat elkülöníteni.

K-means klaszterezés és MDS

# Véletlenszerű minta választása az adatból
set.seed(123)
sample_data <- num_data[sample(nrow(num_data), 1000), ]

MDS

# Távolsági mátrix kiszámítása a minta alapján
dist_matrix <- dist(sample_data)

# MDS futtatása
mds_model <- cmdscale(dist_matrix, k = 2)

Klaszterezés

kmeans_model <- kmeans(sample_data, centers = 3)

Klaszerezés és MDS egyesítése

mds_data <- as.data.frame(mds_model)
mds_data$cluster <- as.factor(kmeans_model$cluster)

Vizualizáció

ggplot(mds_data, aes(V1, V2, color = cluster)) +
  geom_point() +
  theme_minimal() +
  labs(title = "MDS és K-means Klaszterek", x = "MDS1", y = "MDS2")

Az adatok három jól elkülönülő csoportba rendeződnek. A klaszterek szoros elhelyezkedése arra utal, hogy a hozzájuk tartozó zeneszámok hasonló jellemzőkkel bírnak.

MSD 3D-ben

# Véletlenszerű minta (1000 adatpont) kiválasztása
set.seed(123)
sample_data <- num_data[sample(nrow(num_data), 1000), ]

# Távolságmátrix kiszámítása
dist_matrix <- dist(sample_data)

# MDS alkalmazása
mds_model <- cmdscale(dist_matrix, k = 3)  # 3D MDS

Ábrázolás

mds_data_3d <- as.data.frame(mds_model)
mds_data_3d$cluster <- as.factor(kmeans_model$cluster)  # Klaszterek hozzárendelése

3D ábra

library(plotly)
## Warning: package 'plotly' was built under R version 4.4.2
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
plot_ly(mds_data_3d, x = ~V1, y = ~V2, z = ~V3, color = ~cluster, type = "scatter3d", mode = "markers") %>%
  layout(title = "3D MDS és K-means Klaszterek", 
         scene = list(xaxis = list(title = 'MDS1'),
                      yaxis = list(title = 'MDS2'),
                      zaxis = list(title = 'MDS3')))